;; Multiarray utility functions

;; by Konrad Hinsen
;; last updated June 5, 2010

;; Copyright (c) Konrad Hinsen, 2009-2010. All rights reserved.  The use
;; and distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution.  By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license.  You must not
;; remove this notice, or any other, from this software.

(ns multiarray.utility
  (:use [clojure.contrib.def :only [defvar defvar-]]))

(set! *warn-on-reflection* true)

(defn count-range
  "Returns the number of elements in a range seq created with the same
   arguments (integer arguments only)"
  ([end]
     (count-range 0 end 1))
  ([start end]
     (count-range start end 1))
  ([start end step]
     (cond (zero? step)    0
	   (< step 0)      (count-range end start (- step))
	   (>= start end)  0
	   :else           (inc (quot (- end start 1) step)))))

(defn all-true?
  "Return true if all elements of the seq s are true."
  [s]
  (every? identity s))

(defn some-true?
  "Return true if not all elements of the seq s are false."
  [s]
  (if (some identity s)
    true
    false))

(defn all=
  "Return true if all elements of the seq s are equal."
  [s]
  (if (empty? s)
    true
    (apply = s)))

(defn insert
  "Insert item into seq s at position n"
  [s n item]
  (concat (take n s) (list item) (drop n s)))

(defn clip-index-to-size
  [size index back?]
  (if back?
    (let [wrapped (if (< index -1) (+ index size) index)]
      (max (min wrapped (dec size)) -1))
    (let [wrapped (if (neg? index) (+ index size) index)]
      (max (min wrapped size) 0))))

(defn check-index-for-size
  [size index]
  (let [index (if (< index 0) (+ index size) index)]
    (when (or (< index 0) (>= index size))
      (throw (java.lang.IndexOutOfBoundsException.)))
    index))

;
; Find common array element type for items in a sequence
;
(defn common-element-class
  [s]
  (let [class-rank {Byte 0
		    Short 1
		    Integer 2
		    Long 3
		    clojure.lang.Ratio 4
		    Float 5
		    Double 6}
	element-class {0  Byte/TYPE
		       1  Short/TYPE
		       2  Integer/TYPE
		       3  Long/TYPE
		       4  Object
		       5  Float/TYPE
		       6  Double/TYPE
		       99 Object}]
    (if (empty? s)
      Object
      (element-class (reduce max (map #(get class-rank (class %) 99) s))))))

;
; Cast function for a given element type
;
(def cast-fn
     {Byte/TYPE    byte
      Short/TYPE   short
      Integer/TYPE int
      Long/TYPE    long
      Float/TYPE   float
      Double/TYPE  double})

;
; Helper for writing the defmultiarray macro
;

(defn instantiate-template
  [substitution-map form]
  (let [transform (partial instantiate-template substitution-map)
	meta-map  (meta form)
	expanded  (cond
		   (and (sequential? form)
			(= (first form) 'clojure.core/unquote))
		     (substitution-map (second form))
		  (list? form)   (apply list (map transform form))
		  (seq? form)    (doall (map transform form))
		  (vector? form) (vec (map transform form))
		  (map? form)    (into (if (sorted? form) (sorted-map) {})
				       (map transform form))
		  (set? form)    (into (if (sorted? form) (sorted-set) #{})
				       (map transform form))
		  :else form)]
    (if (instance? clojure.lang.IObj expanded)
      (with-meta expanded meta-map)
      expanded)))

(defmacro template
  [substitutions form]
  (let [substitution-map (into {} (map (fn [[a b]]
					 [(list 'quote a) b])
				       (partition 2 substitutions)))]
    `(instantiate-template ~substitution-map (quote ~form))))

;
; Macros for working with Java arrays
;
(defmacro int-loop
  "Execute body with the integer loop-index running from start to end."
  [[loop-index start end] & body]
  `(let [end# (int ~end)]
     (loop [~loop-index (int ~start)]
       (if (< ~loop-index end#)
	 (do ~@body
	     (recur (unchecked-inc ~loop-index)))
	 nil))))

(defmacro afill
  "Set the elements of array (a 1D Java array) to expr in which
   loop-index has been replaced by the index of the element being set."
  [array loop-index expr]
  `(let [array# ~array
         n# (int (alength array#))]
     (int-loop [~loop-index 0 n#]
       (aset array# ~loop-index ~expr))))

(defmacro acopy
  "Set the array elements from the items of seq."
  [array-type array seq]
  (let [array-type-str (str array-type)
	element-cast   (if (= array-type 'objects)
			 'identity
			 (symbol (subs array-type-str
				       0
				       (dec (count array-type-str)))))
	array-sym  (with-meta (gensym) {:tag array-type})]
    `(let [~array-sym ~array
	   n#         (alength ~array-sym)
	   seq#       ~seq]
       (loop [i# (int 0)
	      s# seq#]
	 (when (< i# n#)
	   (aset ~array-sym i# (~element-cast (first s#)))
	   (recur (inc i#) (rest s#)))))))


(set! *warn-on-reflection* false)
